home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / pbc22b.zip / PBC$BAS.ZIP / BOXMENU1.BAS < prev    next >
BASIC Source File  |  1993-04-19  |  13KB  |  342 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  8.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  9.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  10.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  11.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  12.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  13.    DECLARE FUNCTION GetCRT2% ()
  14.    DECLARE FUNCTION GetEGA2% ()
  15.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  16.    DECLARE SUB GetMouseLoc (Row%, Column%)
  17.    DECLARE FUNCTION GetVGA2% ()
  18.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  19.    DECLARE SUB MMButton3 (LeftB%, MidB%, RightB%)
  20.    DECLARE SUB MMCursorOff ()
  21.    DECLARE SUB MMCursorOn ()
  22.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  23.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  24.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  25.  
  26. SUB BoxMenu1 (Mouse%, PickList$(), Picked%(), Marker$, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Picks%)
  27.  
  28.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  29.    IF Visible% THEN LOCATE , , 0
  30.  
  31.    IF LEN(Marker$) > 1 THEN
  32.       LMarker$ = LEFT$(Marker$, 1)
  33.       RMarker$ = MID$(Marker$, 2, 1)
  34.    ELSE
  35.       LMarker$ = "<"
  36.       RMarker$ = ">"
  37.    END IF
  38.  
  39.    LastItem% = 0
  40.    Columns% = 0
  41.    Picks% = 0
  42.    t1% = UBOUND(PickList$, 1)
  43.    FOR tmp% = t1% TO 1 STEP -1
  44.       t2% = LEN(PickList$(tmp%))
  45.       IF t2% THEN
  46.          IF LastItem% = 0 THEN LastItem% = tmp%
  47.          IF Columns% < t2% THEN Columns% = t2%
  48.          IF Picked%(tmp%) THEN Picks% = Picks% + 1
  49.       END IF
  50.    NEXT
  51.    IF LastItem% THEN
  52.       Columns% = Columns% + 2
  53.       IF Columns% > 75 THEN Columns% = 75
  54.       FOR tmp% = 1 TO LastItem%
  55.          IF LEN(PickList$(tmp%)) = 0 THEN Picked%(tmp%) = 0
  56.       NEXT
  57.    ELSE
  58.       Columns% = 14
  59.    END IF
  60.  
  61.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  62.  
  63.    IF GetCRT2% THEN                         ' use fast display unless CGA
  64.       IF GetEGA2% OR GetVGA2% THEN
  65.          Fast% = -1
  66.       ELSE
  67.          Fast% = 0
  68.       END IF
  69.    ELSE
  70.       Fast% = -1
  71.    END IF
  72.  
  73.    RightCol% = LeftCol% + Columns% - 1      ' set right column
  74.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  75.  
  76.    IF Shade% THEN
  77.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  78.       ' this size works regardless of on which side the shadow is displayed...
  79.    ELSE
  80.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  81.    END IF
  82.    DIM SavedScreen%(Words%)
  83.  
  84.    TopRec% = 1
  85.    HiliteRow% = 1
  86.  
  87.    '--- save the screen
  88.    IF Mouse% THEN MMCursorOff
  89.    DSeg% = VARSEG(SavedScreen%(1))
  90.    DOfs% = VARPTR(SavedScreen%(1))
  91.    IF Shade% THEN
  92.       IF Shade% < -2 THEN
  93.          DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  94.       ELSE
  95.          DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
  96.       END IF
  97.    ELSE
  98.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  99.    END IF
  100.  
  101.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  102.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
  103.    IF Mouse% THEN MMCursorOn
  104.    GOSUB DisplayItems
  105.  
  106.    DO
  107.       '--- get input from appropriate device(s)
  108.       IF LeftButton% THEN Delay18th 2
  109.       DO
  110.          IF Mouse% THEN MMButton3 LeftButton%, MidButton%, RightButton%
  111.          IF LeftButton% = 0 AND MidButton% = 0 AND RightButton% = 0 THEN
  112.             BIOSInkey AsciiCode%, ScanCode%
  113.          END IF
  114.       LOOP UNTIL LeftButton% OR MidButton% OR RightButton% OR AsciiCode% OR ScanCode%
  115.       '--- handle mouse input, if any
  116.       IF Mouse% THEN
  117.          IF RightButton% THEN
  118.             AsciiCode% = 27
  119.          ELSEIF (LastItem% < 1) AND (LeftButton% OR MidButton%) THEN
  120.             AsciiCode% = 27
  121.          ELSEIF MidButton% THEN
  122.             AsciiCode% = 13
  123.          ELSEIF LeftButton% THEN
  124.             GetMouseLoc MouseRow%, MouseCol%
  125.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  126.                IF MouseCol% = RightCol% + 1 THEN
  127.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  128.                   IF tmp% = 24 THEN
  129.                      ' convert to ^E (same as up arrow)
  130.                      AsciiCode% = 5
  131.                   ELSEIF tmp% = 25 THEN
  132.                      ' convert to ^X (same as down arrow)
  133.                      AsciiCode% = 24
  134.                   END IF
  135.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  136.                   IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
  137.                      HiLiteRow% = MouseRow% - TopRow% + 1
  138.                      AsciiCode% = 32
  139.                   END IF
  140.                END IF
  141.             END IF
  142.          END IF
  143.       END IF
  144.       '--- handle keyboard input, if any
  145.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  146.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  147.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  148.             SELECT CASE AsciiCode%
  149.                CASE 3                     ' ^QC converts to ^<PgDn>
  150.                   AsciiCode% = 0
  151.                   ScanCode% = 118
  152.                CASE 18                    ' ^QR converts to ^<PgUp>
  153.                   AsciiCode% = 0
  154.                   ScanCode% = 132
  155.                CASE ELSE
  156.                   AsciiCode% = 0
  157.                   ScanCode% = 0
  158.             END SELECT
  159.          END IF
  160.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  161.             ' <HOME>
  162.             IF HiliteRow% > 1 THEN
  163.                HiliteRow% = 1
  164.                GOSUB DisplayItems
  165.             END IF
  166.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  167.             ' <END>
  168.             IF TopRec% + Rows% > LastItem% THEN
  169.                HiliteRow% = LastItem% - TopRec% + 1
  170.             ELSE
  171.                HiliteRow% = Rows%
  172.             END IF
  173.             GOSUB DisplayItems
  174.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  175.             ' <CTRL><PGDN>
  176.             TopRec% = LastItem% - Rows% + 1
  177.             IF TopRec% < 1 THEN TopRec% = 1
  178.             IF TopRec% + Rows% > LastItem% THEN
  179.                HiliteRow% = LastItem% - TopRec% + 1
  180.             ELSE
  181.                HiliteRow% = Rows%
  182.             END IF
  183.             GOSUB DisplayItems
  184.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  185.             ' <CTRL><PGUP>
  186.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  187.                TopRec% = 1
  188.                HiliteRow% = 1
  189.                GOSUB DisplayItems
  190.             END IF
  191.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  192.             ' ^C or PgDn
  193.             IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
  194.                TopRec% = TopRec% + Rows%
  195.             ELSE
  196.                TopRec% = LastItem% - Rows% + 1
  197.                IF TopRec% < 1 THEN TopRec% = 1
  198.             END IF
  199.             IF TopRec% > LastItem% THEN TopRec% = LastItem%
  200.             IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
  201.                HiliteRow% = LastItem% - TopRec% + 1
  202.             END IF
  203.             GOSUB DisplayItems
  204.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  205.             ' ^E or up arrow
  206.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  207.                IF HiliteRow% > 1 THEN
  208.                   HiliteRow% = HiliteRow% - 1
  209.                ELSE
  210.                   TopRec% = TopRec% - 1
  211.                END IF
  212.                GOSUB DisplayItems
  213.             END IF
  214.          ELSEIF AsciiCode% = 13 THEN
  215.             ' <CR>
  216.             IF LastItem% < 1 THEN
  217.                AsciiCode% = 27
  218.                LemmeOuttaHere% = -1
  219.             ELSE
  220.                DonePicking% = -1
  221.             END IF
  222.          ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
  223.             ' ^X or down arrow
  224.             IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
  225.                HiliteRow% = HiliteRow% + 1
  226.                GOSUB DisplayItems
  227.             ELSE
  228.                IF TopRec% + Rows% - 1 < LastItem% THEN
  229.                   TopRec% = TopRec% + 1
  230.                   GOSUB DisplayItems
  231.                END IF
  232.             END IF
  233.          ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
  234.             ' ^R or PgUp
  235.             IF TopRec% > Rows% THEN
  236.                TopRec% = TopRec% - Rows%
  237.                GOSUB DisplayItems
  238.             ELSE
  239.                IF TopRec% > 1 THEN
  240.                   TopRec% = 1
  241.                   GOSUB DisplayItems
  242.                END IF
  243.             END IF
  244.          ELSEIF AsciiCode% = 27 THEN
  245.             ' <ESC>
  246.             LemmeOuttaHere% = -1
  247.          ELSEIF AsciiCode% = 32 THEN
  248.             ' <space>
  249.             IF TopRec% + HiLiteRow% - 1 <= LastItem% THEN
  250.                tmp% = TopRec% + HiLiteRow% - 1
  251.                Picked%(tmp%) = NOT Picked%(tmp%)
  252.                IF Picked%(tmp%) THEN
  253.                   Picks% = Picks% + 1
  254.                ELSE
  255.                   Picks% = Picks% - 1
  256.                END IF
  257.                GOSUB DisplayItems
  258.             END IF
  259.          ELSEIF AsciiCode% = 10 THEN
  260.             ' <CTRL><CR>
  261.             FOR tmp% = 1 TO LastItem%
  262.                Picked%(tmp%) = -1
  263.             NEXT
  264.             Picks% = LastItem%
  265.             GOSUB DisplayItems
  266.          ELSEIF AsciiCode% = 127 THEN
  267.             ' <CTRL><BACKSPACE>
  268.             FOR tmp% = 1 TO LastItem%
  269.                Picked%(tmp%) = 0
  270.             NEXT
  271.             Picks% = 0
  272.             GOSUB DisplayItems
  273.          END IF
  274.       END IF
  275.    LOOP UNTIL DonePicking% OR LemmeOuttaHere%
  276.  
  277.    IF LemmeOuttaHere% AND Picks% THEN
  278.       FOR tmp% = 1 TO LastItem%
  279.          Picked%(tmp%) = 0
  280.       NEXT
  281.       Picks% = 0
  282.    END IF
  283.  
  284.    '--- restore the screen
  285.    IF Mouse% THEN MMCursorOff
  286.    DSeg% = VARSEG(SavedScreen%(1))
  287.    DOfs% = VARPTR(SavedScreen%(1))
  288.    IF Shade% THEN
  289.       IF Shade% < -2 THEN
  290.          DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  291.       ELSE
  292.          DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
  293.       END IF
  294.    ELSE
  295.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  296.    END IF
  297.    IF Mouse% THEN MMCursorOn
  298.    IF Visible% THEN LOCATE , , 1
  299.  
  300.    EXIT SUB
  301.  
  302. DisplayItems:
  303.    IF Mouse% THEN MMCursorOff
  304.    IF LastItem% < 1 THEN
  305.       XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
  306.    ELSE
  307.       ' update scroll bar as needed
  308.       IF Rows% < LastItem% THEN
  309.          FOR Row% = TopRow% TO BottomRow%
  310.             XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
  311.          NEXT
  312.          IF TopRec% > 1 AND Rows% > 1 THEN
  313.             XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  314.          END IF
  315.          IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
  316.             XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  317.          END IF
  318.       END IF
  319.       ' update item list
  320.       FOR Row% = 1 TO Rows%
  321.          tmp% = TopRec% + Row% - 1
  322.          IF tmp% <= LastItem% THEN
  323.             IF Picked%(tmp%) THEN
  324.                St$ = LMarker$ + LEFT$(LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns% - 2) + RMarker$
  325.             ELSE
  326.                St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
  327.             END IF
  328.          ELSE
  329.             St$ = SPACE$(Columns%)
  330.          END IF
  331.          IF Row% = HiliteRow% THEN
  332.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
  333.          ELSE
  334.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
  335.          END IF
  336.       NEXT
  337.    END IF
  338.    IF Mouse% THEN MMCursorOn
  339.    RETURN
  340.  
  341. END SUB
  342.